home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form frmDiagram
- Appearance = 0 'Flat
- BackColor = &H80000005&
- Caption = "Example 3: Diagrams"
- ClientHeight = 3825
- ClientLeft = 405
- ClientTop = 2070
- ClientWidth = 5445
- FillColor = &H0000FFFF&
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 4230
- Left = 345
- LinkTopic = "Form3"
- MDIChild = -1 'True
- ScaleHeight = 3825
- ScaleWidth = 5445
- Tag = "3"
- Top = 1725
- Width = 5565
- Begin AddFlowLib.AddFlow AddFlow1
- Height = 3015
- Left = 600
- TabIndex = 0
- Top = 600
- Width = 4245
- _Version = 65536
- _ExtentX = 7488
- _ExtentY = 5318
- _StockProps = 101
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "Arial"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- BorderStyle = 1
- ScrollBars = 3
- Shape = 0
- LinkStyle = 0
- Alignment = 7
- AutoSize = 0
- ArrowDst = 3
- ArrowOrg = 0
- DrawStyle = 0
- DrawWidth = 1,4013e-45
- ReadOnly = 0 'False
- MultiSel = -1 'True
- CanDrawNode = -1 'True
- CanDrawLink = -1 'True
- CanMoveNode = -1 'True
- CanSizeNode = -1 'True
- CanStretchLink = -1 'True
- CanMultiLink = -1 'True
- Transparent = 0 'False
- ShowGrid = 0 'False
- Hidden = 0 'False
- Rigid = 0 'False
- DisplayHandles = -1 'True
- AutoScroll = -1 'True
- xGrid = 7,00649e-45
- yGrid = 7,00649e-45
- xZoom = 100
- yZoom = 100
- FillColor = 16777215
- DrawColor = 0
- ForeColor = 0
- BackPicture = "Diagram.frx":0000
- End
- Attribute VB_Name = "frmDiagram"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- Dim n%, flag%
- Dim X0&, Y0&
- Private Sub Form_Activate()
- frmMain.ActivateForm
- End Sub
- Private Sub Form_Deactivate()
- frmMain.DeactivateForm
- End Sub
- Private Sub Form_Load()
- frmMain.ShowExample(2).Enabled = False
- n = 1
- flag = False
- Dim nodx As afNode, lnkx As afLink
- With AddFlow1
- .Left = 0
- .Top = 0
- ' Just to accelerate display (Don't forget to reset it at the end)
- .Repaint = False
- .DrawColor = RGB(255, 0, 0)
- .FillColor = &HC0FFFF
- ' Create nodes
- Set nodx = .Nodes.Add(600, 200, 500, 500)
- nodx.Text = n
- n = n + 1
- Set nodx = .Nodes.Add(2100, 200, 500, 500)
- nodx.Text = n
- n = n + 1
- Set nodx = .Nodes.Add(1600, 1700, 500, 500)
- nodx.Text = n
- n = n + 1
- Set nodx = .Nodes.Add(100, 1700, 500, 500)
- nodx.Text = n
- n = n + 1
- ' Create links
- Set lnkx = .Nodes(1).OutLinks.Add(.Nodes(2))
- Set lnkx = .Nodes(2).OutLinks.Add(.Nodes(3))
- Set lnkx = .Nodes(3).OutLinks.Add(.Nodes(4))
- Set lnkx = .Nodes(1).OutLinks.Add(.Nodes(4))
- Set lnkx = .Nodes(1).OutLinks.Add(.Nodes(3))
- .Repaint = True
- End With
- End Sub
- Private Sub Form_Resize()
- If WindowState <> 1 And ScaleHeight <> 0 Then
- AddFlow1.Height = ScaleHeight
- AddFlow1.Width = ScaleWidth
- End If
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- frmMain.ShowExample(2).Enabled = True
- End Sub
- Private Sub AddFlow1_KeyDown(KeyCode As Integer, Shift As Integer)
- Const KEY_DELETE = &H2E
- If KeyCode = KEY_DELETE Then
- AddFlow1.DeleteSel
- End If
- End Sub
- Private Sub AddFlow1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Me.SetFocus
- If AddFlow1.PointedArea = 5 Then
- flag = True
- X0 = X
- Y0 = Y
- End If
- End Sub
- Private Sub AddFlow1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim Xabs As Single, Yabs As Single
- Dim Org As afNode, Dst As afNode, link As afLink
- Dim Action As Long
- Action = AddFlow1.LastUserAction()
- If Action = 1 Then
- AddFlow1.SelectedNode.Text = n
- n = n + 1
- End If
- If flag = True Then
- flag = False
- ' If a link has been created, don't create a new one ==> exit
- If Action = 2 Then Exit Sub
- If (Abs(X - X0) < 300 And Abs(Y - Y0) < 300) Then Exit Sub
- ' Origin node of next created link
- Set Org = AddFlow1.SelectedNode
- ' No current item
- Set AddFlow1.SelectedNode = Nothing
- Xabs = X + AddFlow1.xScroll
- Yabs = Y + AddFlow1.yScroll
- ' Create destination node
- Set Dst = AddFlow1.Nodes.Add(Xabs - 250, Yabs - 250, 500, 500)
- If Not (Dst Is Nothing) Then
- Dst.Text = Str(n)
- n = n + 1
- ' Create link
- Set link = Org.OutLinks.Add(Dst)
- End If
- End If
- End Sub
-